home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / TOOLPAS2 / MINICRT2.PAS < prev    next >
Pascal/Delphi Source File  |  1990-05-21  |  13KB  |  444 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. (*
  14.  * MiniCrt - simplified version of Borland's CRT unit.
  15.  * Does not EVER do direct video.  The standard crt unit
  16.  * locks up multi-taskers with its direct video checking before
  17.  * the user program can turn it off.
  18.  *
  19.  * (3-1-89)
  20.  *
  21.  *)
  22.  
  23. {$i prodef.inc}
  24.  
  25. unit Mini{Crt};
  26.  
  27. interface
  28.  
  29.    uses Dos;
  30.  
  31.    var
  32.       stdout:  text;  {output through dos for ANSI compatibility}
  33.  
  34.    const
  35.       scroll_line: byte = 23;
  36.       window_y1  : byte = 1;
  37.       window_y2  : byte = 25;
  38.       TextAttr   : byte = $07;
  39.       key_pending: char = #0;
  40.       directVideo: boolean = true;
  41.  
  42.    procedure StdWrite(var s; len: integer);
  43.  
  44.    function KeyPressed: Boolean;
  45.    function ReadKey: Char;
  46.  
  47.    procedure Window(X1,Y1,X2,Y2: Byte);  {only partial support}
  48.    procedure SetScrollPoint(Y2: Byte);
  49.    procedure FullScreen;
  50.  
  51.    procedure GotoXY(X,Y: Byte);
  52.    function WhereX: Byte;
  53.    function WhereY: Byte;
  54.  
  55.    procedure ClrScr;
  56.    procedure ClrEol;
  57.  
  58.    procedure NormalVideo;
  59.    procedure LowVideo;
  60.    procedure ReverseVideo;
  61.    procedure BlinkVideo;
  62.  
  63.    procedure push_bp; inline($55);
  64.    procedure pop_bp; inline($5D);
  65.  
  66.  
  67.  
  68.    (* -------------------------------------------------------- *)
  69.    procedure ScrollUp;
  70.    {$F+} function ConFlush(var F: TextRec): integer; {$F-}
  71.    {$F+} function ConOutput(var F: TextRec): integer; {$F-}
  72.    {$F+} function ConOpen(var F: TextRec): Integer; {$F-}
  73.  
  74.  
  75. (* -------------------------------------------------------- *)
  76.  
  77. implementation
  78.  
  79.  
  80.    (* -------------------------------------------------------- *)
  81.    procedure StdWrite(var s; len: integer);
  82.    begin
  83.       {call fastest bios method if 'directVideo' is enabled}
  84.       if directVideo then
  85.          Inline(
  86.            $55/                   {    push bp}
  87.            $8B/$4E/<len/          {    mov cx,[bp+<len]}
  88.            $C4/$76/<s/            {    les si,[bp+<s]}
  89.            $41/                   {    inc cx}
  90.            $E9/$0A/$00/           {    jmp first}
  91.                                   {next:}
  92.            $26/$AC/               {    es: lodsb}
  93.            $51/                   {    push cx}
  94.            $56/                   {    push si}
  95.            $06/                   {    push es}
  96.            $CD/$29/               {    int $29}
  97.            $07/                   {    pop es}
  98.            $5E/                   {    pop si}
  99.            $59/                   {    pop cx}
  100.                                   {first:}
  101.            $E2/$F4/               {    loop next}
  102.                                   {exit:}
  103.            $5D)                   {    pop bp}
  104.  
  105.       else  {otherwise use simple write to stdout}
  106.          Inline(
  107.            $B8/$00/$40/           {    mov ax,$4000}
  108.            $BB/$01/$00/           {    mov bx,1}
  109.            $8B/$4E/<len/          {    mov cx,[bp+<len]}
  110.            $1E/                   {    push ds}
  111.            $C5/$56/<s/            {    lds dx,[bp+<s]}
  112.            $CD/$21/               {    int $21}
  113.            $1F);                  {    pop ds}
  114.    end;
  115.  
  116.  
  117.    (* -------------------------------------------------------- *)
  118.    function ReadKey: Char;
  119.    var
  120.       reg: registers;
  121.    begin
  122.       if key_pending <> #0 then
  123.       begin
  124.          ReadKey := key_pending;
  125.          key_pending := #0;
  126.          exit;
  127.       end;
  128.  
  129.       reg.ax := $0000;   {wait for character}
  130.       intr($16,reg);
  131.       if reg.al = 0 then
  132.          key_pending := chr(reg.ah);
  133.  
  134.       ReadKey := chr(reg.al);
  135.    end;
  136.  
  137.  
  138.    (* -------------------------------------------------------- *)
  139.    function KeyPressed: Boolean;
  140. (********
  141.    var
  142.       reg: registers;
  143.    begin
  144.       reg.ax := $0100;   {check for character}
  145.       intr($16,reg);
  146.       KeyPressed := ((reg.flags and FZero) = 0) or (key_pending <> #0);
  147. *********)
  148.    begin
  149.       Inline(
  150.         $B8/$00/$01/                {mov ax,$0100}
  151.         $CD/$16/                    {int $16}
  152.         $B0/$01/                    {mov al,1}
  153.         $75/$09/                    {jnz exit}
  154.         $80/$3E/>key_pending/$00/   {cmp byte [>key_pending],0}
  155.         $75/$02/                    {jnz exit}
  156.         $B0/$00/                    {mov al,0}
  157.                                {exit:}
  158.         $88/$46/<KeyPressed);       {mov [bp+<KeyPressed],al}
  159.    end;
  160.  
  161.  
  162.    (* -------------------------------------------------------- *)
  163.    procedure Window(X1,Y1,X2,Y2: Byte);
  164.    begin
  165.       window_y1 := y1;
  166.       window_y2 := y2;
  167.    end;
  168.  
  169.    procedure FullScreen;
  170.    begin
  171.       window_y1 := 1;
  172.       window_y2 := scroll_line+2;
  173.    end;
  174.  
  175.    procedure SetScrollPoint(Y2: Byte);
  176.    begin
  177.       window_y1 := 1;
  178.       window_y2 := Y2;
  179.    end;
  180.  
  181.  
  182.    (* -------------------------------------------------------- *)
  183.    procedure GotoXY(X,Y: Byte);
  184.    begin
  185.       Inline(
  186.         $B4/$02/               {mov ah,2}
  187.         $31/$DB/               {xor bx,bx}
  188.         $8A/$76/<y/            {mov dh,[bp+<y]}
  189.         $FE/$CE/               {dec dh}
  190.         $8A/$56/<x/            {mov dl,[bp+<x]}
  191.         $FE/$CA/               {dec dl}
  192.         $55/                   {push bp}
  193.         $CD/$10/               {int $10}
  194.         $5D);                  {pop bp}
  195.    end;
  196.  
  197.  
  198.    (* -------------------------------------------------------- *)
  199.    function WhereX: Byte;
  200.    begin
  201.       Inline(
  202.         $B4/$03/               {mov ah,3}
  203.         $30/$FF/               {xor bh,bh}
  204.         $55/                   {push bp}
  205.         $CD/$10/               {int $10}
  206.         $5D/                   {pop bp}
  207.         $FE/$C2/               {inc dl}
  208.         $88/$56/<WhereX);      {mov [bp+<WhereX],dl}
  209.    end;
  210.  
  211.    function WhereY: Byte;
  212.    begin
  213.       Inline(
  214.         $B4/$03/               {mov ah,3}
  215.         $30/$FF/               {xor bh,bh}
  216.         $55/                   {push bp}
  217.         $CD/$10/               {int $10}
  218.         $5D/                   {pop bp}
  219.         $FE/$C6/               {inc dh}
  220.         $88/$76/<WhereY);      {mov [bp+<WhereY],dh}
  221.    end;
  222.  
  223.  
  224.    (* -------------------------------------------------------- *)
  225.    procedure ClrScr;
  226.    begin
  227.       Inline(
  228.         $55/                   {push bp}
  229.         $B8/$00/$06/           {mov ax,$0600}
  230.         $31/$C9/               {xor cx,cx}
  231.         $8A/$36/>window_y2/    {mov dh,[>window_y2]}
  232.         $FE/$CE/               {dec dh}
  233.         $B2/$4F/               {mov dl,79}
  234.         $8A/$3E/>TextAttr/     {mov bh,[>TextAttr]}
  235.         $CD/$10/               {int $10}
  236.         $B4/$02/               {mov ah,2}
  237.         $31/$DB/               {xor bx,bx}
  238.         $31/$D2/               {xor dx,dx}
  239.         $CD/$10/               {int $10}
  240.         $5D);                  {pop bp}
  241.    end;
  242.  
  243.  
  244.    (* -------------------------------------------------------- *)
  245.    procedure ClrEol;
  246.    begin
  247.       Inline(
  248.         $B4/$03/               {mov ah,3}
  249.         $31/$DB/               {xor bx,bx}
  250.         $55/                   {push bp}
  251.         $CD/$10/               {int $10}
  252.         $B8/$00/$06/           {mov ax,$0600}
  253.         $89/$D1/               {mov cx,dx}
  254.         $B2/$4F/               {mov dl,79}
  255.         $8A/$3E/>TextAttr/     {mov bh,[>TextAttr]}
  256.         $CD/$10/               {int $10}
  257.         $5D);                  {pop bp}
  258.    end;
  259.  
  260.  
  261.    (* -------------------------------------------------------- *)
  262.    procedure NormalVideo;
  263.    begin
  264.       TextAttr := $0F;
  265.    end;
  266.  
  267.    procedure LowVideo;
  268.    begin
  269.       TextAttr := $07;
  270.    end;
  271.  
  272.    procedure ReverseVideo;
  273.    begin
  274.       TextAttr := $70;
  275.    end;
  276.  
  277.    procedure BlinkVideo;
  278.    begin
  279.       TextAttr := $F0;
  280.    end;
  281.  
  282.  
  283.    (* -------------------------------------------------------- *)
  284.    procedure ScrollUp;
  285.    begin
  286.       Inline(
  287.         $B8/$01/$06/           {mov ax,$0601;}
  288.         $31/$C9/               {xor cx,cx}
  289.         $8A/$36/>window_y2/    {mov dh,[>window_y2]}
  290.         $FE/$CE/               {dec dh}
  291.         $B2/$4F/               {mov dl,79}
  292.         $8A/$3E/>TextAttr/     {mov bh,[>TextAttr]}
  293.         $55/                   {push bp}
  294.         $CD/$10/               {int $10}
  295.         $5D);                  {pop bp}
  296.    end;
  297.  
  298.  
  299.    (* -------------------------------------------------------- *)
  300.    {$F+} function ConFlush(var F: TextRec): integer; {$F-}
  301.    var
  302.       P:    Word;
  303.       reg:  registers;
  304.       x,y:  byte;
  305.       ch:   char;
  306.  
  307.    begin
  308.       if F.BufPos > 0 then
  309.       begin
  310.          {get present cursor position}
  311.          Inline(
  312.            $B4/$03/               {mov ah,3}
  313.            $31/$DB/               {xor bx,bx}
  314.            $55/                   {push bp}
  315.            $CD/$10/               {int $10}
  316.            $5D/                   {pop bp}
  317.            $FE/$C6/               {inc dh}
  318.            $88/$76/<y/            {mov [bp+<y],dh}
  319.            $FE/$C2/               {inc dl}
  320.            $88/$56/<x);           {mov [bp+<x],dl}
  321.  
  322.          {process each character in the buffer}
  323.          for P := 0 to F.BufPos-1 do
  324.          begin
  325.             ch := F.BufPtr^[P];
  326.  
  327.             case ch of
  328.                #7:  {$i+} write(stdout,ch); {$i-}
  329.  
  330.                #8:  if x > 1 then dec(x);       {backspace}
  331.  
  332.                #9:  x := (x+8) and $F8;         {tab}
  333.  
  334.               #10:  if y {>}= window_y2 then    {scroll when needed}
  335.                        ScrollUp
  336.                     else
  337.                        inc(y);
  338.  
  339.               #13:  x := 1;                     {c/r}
  340.  
  341.             else
  342.                begin
  343.                   Inline(
  344.                     $B4/$09/               {mov ah,9}
  345.                     $8A/$46/<ch/           {mov al,[bp+<ch]}
  346.                     $B9/$01/$00/           {mov cx,1}
  347.                     $8A/$1E/>TextAttr/     {mov bl,[>TextAttr]}
  348.                     $30/$FF/               {xor bh,bh}
  349.                     $55/                   {push bp}
  350.                     $CD/$10/               {int $10}
  351.                     $5D);                  {pop bp}
  352.  
  353.  
  354.                   if x = 80 then   {line wrap?}
  355.                   begin
  356.                      x := 1;
  357.                      if y >= window_y2 then   {scroll during wrap?}
  358.                         ScrollUp
  359.                      else
  360.                         inc(y);
  361.                   end
  362.                   else
  363.                      inc(x);
  364.                end;
  365.             end;
  366.  
  367.             {position physical cursor}
  368.             Inline(
  369.               $B4/$02/               {mov ah,2}
  370.               $31/$DB/               {xor bx,bx}
  371.               $8A/$76/<y/            {mov dh,[bp+<y]}
  372.               $FE/$CE/               {dec dh}
  373.               $8A/$56/<x/            {mov dl,[bp+<x]}
  374.               $FE/$CA/               {dec dl}
  375.               $55/                   {push bp}
  376.               $CD/$10/               {int $10}
  377.               $5D);                  {pop bp}
  378.          end;
  379.  
  380.          F.BufPos:=0;
  381.       end;
  382.  
  383.       ConFlush := 0;
  384.    end;
  385.  
  386.  
  387.    (* -------------------------------------------------------- *)
  388.    {$F+} function ConOutput(var F: TextRec): integer; {$F-}
  389.    begin
  390.       ConOutput := ConFlush(F);
  391.    end;
  392.  
  393.  
  394.    {$F+} function ConOpen(var F: TextRec): Integer; {$F-}
  395.    begin
  396.       F.InOutFunc := @ConOutput;
  397.       F.FlushFunc := @ConFlush;
  398.       F.CloseFunc := @ConFlush;
  399.       F.BufPos := 0;
  400.       ConOpen := 0;
  401.    end;
  402.  
  403.  
  404.  
  405. (* -------------------------------------------------------- *)
  406. begin
  407.    if GetEnv('OVCRT') <> '' then
  408.       directVideo := false;
  409.  
  410.    {determine scroll line if ega/vga in >25 line modes}
  411.    if directVideo then
  412.    Inline(
  413.      $31/$DB/                 {xor bx,bx}
  414.      $8E/$C3/                 {mov es,bx}
  415.      $26/$F6/$06/$87/$04/$08/ {test byte es:[$487],8}
  416.      $75/$13/                 {jnz noega}
  417.      $B8/$30/$11/             {mov ax,$1130}
  418.      $8A/$16/>scroll_line/    {mov dl,[>scroll_line]}
  419.      $FE/$C2/                 {inc dl}
  420.      $55/                     {push bp}
  421.      $CD/$10/                 {int $10}
  422.      $5D/                     {pop bp}
  423.      $FE/$CA/                 {dec dl}
  424.      $88/$16/>scroll_line);   {mov [>scroll_line],dl}
  425.                             {noega:}
  426.  
  427.    FullScreen;
  428.  
  429.    with TextRec(output) do
  430.    begin
  431.       BufPos := 0;
  432.       InOutFunc := @ConOutput;
  433.       FlushFunc := @ConFlush;
  434.       OpenFunc  := @ConOpen;
  435.    end;
  436.  
  437.    {$i-}
  438.    assign(stdout,'');
  439.    rewrite(stdout);
  440.    {$i+}
  441.  
  442. end.
  443.  
  444.